home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / perl5 / IPC / Open2.pm next >
Text File  |  1995-07-02  |  2KB  |  63 lines
  1. package IPC::Open2;
  2. require 5.000;
  3. require Exporter;
  4. use Carp;
  5.  
  6. @ISA = qw(Exporter);
  7. @EXPORT = qw(open2);
  8.  
  9. # &open2: tom christiansen, <tchrist@convex.com>
  10. #
  11. # usage: $pid = open2('rdr', 'wtr', 'some cmd and args');
  12. #    or  $pid = open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
  13. #
  14. # spawn the given $cmd and connect $rdr for
  15. # reading and $wtr for writing.  return pid
  16. # of child, or 0 on failure.  
  17. # 
  18. # WARNING: this is dangerous, as you may block forever
  19. # unless you are very careful.  
  20. # 
  21. # $wtr is left unbuffered.
  22. # 
  23. # abort program if
  24. #    rdr or wtr are null
  25. #     pipe or fork or exec fails
  26.  
  27. $fh = 'FHOPEN000';  # package static in case called more than once
  28.  
  29. sub open2 {
  30.     local($kidpid);
  31.     local($dad_rdr, $dad_wtr, @cmd) = @_;
  32.  
  33.     $dad_rdr ne ''         || croak "open2: rdr should not be null";
  34.     $dad_wtr ne ''         || croak "open2: wtr should not be null";
  35.  
  36.     # force unqualified filehandles into callers' package
  37.     local($package) = caller;
  38.     $dad_rdr =~ s/^[^']+$/$package'$&/;
  39.     $dad_wtr =~ s/^[^']+$/$package'$&/;
  40.  
  41.     local($kid_rdr) = ++$fh;
  42.     local($kid_wtr) = ++$fh;
  43.  
  44.     pipe($dad_rdr, $kid_wtr)     || croak "open2: pipe 1 failed: $!";
  45.     pipe($kid_rdr, $dad_wtr)     || croak "open2: pipe 2 failed: $!";
  46.  
  47.     if (($kidpid = fork) < 0) {
  48.     croak "open2: fork failed: $!";
  49.     } elsif ($kidpid == 0) {
  50.     close $dad_rdr; close $dad_wtr;
  51.     open(STDIN,  "<&$kid_rdr");
  52.     open(STDOUT, ">&$kid_wtr");
  53.     warn "execing @cmd\n" if $debug;
  54.     exec @cmd;
  55.     croak "open2: exec of @cmd failed";   
  56.     } 
  57.     close $kid_rdr; close $kid_wtr;
  58.     select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
  59.     $kidpid;
  60. }
  61. 1; # so require is happy
  62.  
  63.